home *** CD-ROM | disk | FTP | other *** search
/ Over 1,000 Windows 95 Programs / Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso / 1132 / dyna2.txt < prev    next >
Text File  |  1997-04-16  |  9KB  |  330 lines
  1. DYNAMIC VECTORS AND MATRICES Unit
  2.  
  3. Copyright Southern Scientific cc.
  4. 17 Capri Road 
  5. St James
  6. South Africa
  7. 7951
  8. November 1991
  9.  
  10.  
  11. THE INTERFACE SECTION
  12.  
  13.  
  14.  
  15. const
  16.      dynaErrmsgcount = 10;
  17.      DynaErrMsg  : array[1..dynaerrmsgcount] of string[80]
  18.                    =('<<<Index out of range in dynavec.put>>>',
  19.                      '<<<Index out of range in dynavec.get>>>',
  20.                      '<<<Negative or zero index in dynavec.expandat>>>',
  21.                      '<<<Index out of range in dynavec.contractat>>>',
  22.                      '<<<Index out of range in dynamat.deletecol>>>',
  23.                      '<<<Index out of range in dynamat.deleterow>>>',
  24.                      '<<<Row index out of range in dynamat.get>>>',
  25.                      '<<<Row index out of range in dynamat.put>>>',
  26.                      '<<<Index out of range in dynamat.getrow>>>',
  27.                      '<<<Index out of range in dynamat.getcol>>>'
  28.                     );
  29.  
  30.  
  31.  
  32. var
  33.    DynaError    : integer;   {flags error conditions}
  34.  
  35. type
  36.  
  37.     pfloat    = ^float;
  38. {=-----------------------------------}
  39.     float     = object(tobject)      { A floating point object }
  40. {=-----------------------------------}
  41.  
  42.        num    : double;
  43.  
  44.        constructor init(a: double);
  45.        function    getnum: double;
  46.        procedure   putnum( a: double);
  47.        constructor load(var s: tstream);
  48.        procedure   store(var s: tstream); virtual;
  49.        end;
  50.  
  51. const
  52.  
  53. Rfloat : tstreamrec = (
  54.  
  55.        objtype  : 11500;
  56.        vmtlink  : ofs(typeof(float)^);
  57.        load     :@float.load;
  58.        store    :@float.store
  59.        );
  60.  
  61.  
  62. type
  63.  
  64.      Pdynavec = ^dynavec;
  65. {=-----------------------------------}
  66.      dynavec  = object(tcollection)  { A simple collection of float}
  67. {=-----------------------------------}
  68.  
  69.      constructor init(alimit,adelta : integer);
  70.      function  get(i: integer): double;
  71.      procedure put(i: integer; num : double);
  72.      procedure expandat  (i : integer);
  73.      procedure contractat(i : integer);
  74.      function norm : double;
  75.      end;
  76.  
  77. const
  78.  
  79. Rdynavec : tstreamrec = (
  80.  
  81.        objtype  : 11501;
  82.        vmtlink  : ofs(typeof(dynavec)^);
  83.        load     :@dynavec.load;
  84.        store    :@dynavec.store
  85.        );
  86.  
  87.  
  88. type
  89.  
  90.  
  91.      Pdynamat = ^dynamat;
  92. {=-----------------------------------}
  93.      dynaMAT = OBJECT(tobject)
  94. {=-----------------------------------}
  95.  
  96.      nrow           : integer;
  97.      ncol           : integer;
  98.      rows           : pcollection;   {of dynavec }
  99.      cols           : pcollection;   {of dynavec }
  100.  
  101.      constructor init(maxrow, maxcol : integer);
  102.      constructor load(var s: tstream);
  103.      procedure   store( var s: tstream);
  104.      procedure   addrow(i : integer);
  105.      procedure   addcol(j : integer);
  106.      procedure   deleterow(i : integer);
  107.      procedure   deletecol(j : integer);
  108.      procedure   put(i,j  : integer; value : double);
  109.      function    get(i,j  : integer) : double;
  110.      procedure   getrow(i : integer; var pvec : pdynavec);
  111.      procedure   getcol(j : integer; var pvec : pdynavec);
  112.      destructor  done; virtual;
  113.  
  114.      end;
  115.  
  116. const
  117. Rdynamat : tstreamrec = (
  118.  
  119.        objtype  : 11502;
  120.        vmtlink  : ofs(typeof(dynamat)^);
  121.        load     :@dynamat.load;
  122.        store    :@dynamat.store
  123.        );
  124.  
  125. TYPE
  126.  
  127.  
  128. Pcroupier  = ^Croupier;
  129. {---------------------------}
  130.  croupier  = object(tobject)
  131. {---------------------------}
  132.  
  133.    index         : pdynavec;
  134.    decksize      : integer;
  135.  
  136.    constructor init(size  : integer);
  137.    procedure newdeck; virtual;
  138.    function deal( deck : pcollection) : pointer; virtual;
  139.    destructor done; virtual;
  140.    end;
  141.  
  142.  
  143.  
  144.  
  145. procedure printvec(var f: text;
  146.                    width        : integer;
  147.                    var vector   : dynavec) ;
  148.  
  149. procedure printmat(var mat: dynamat);
  150. function  dynadotprod(a,b : dynavec) : double;
  151. procedure printdynaerror;
  152.  
  153.  
  154.  
  155.  
  156. THE FLOAT OBJECT
  157.  
  158.  
  159. It may not have been wise to make an object of a floating point
  160. number, but I did this to make the streamability of the objects
  161. higher up in the hierarchy tidier.  I don' t think  it adds too
  162. much overhead, and the vector and matrix objects hide the Float
  163. object from the user.  Besides, I like it if everything is an
  164. object.  So there.  But OK, screams of protest will make me
  165. change it.
  166.  
  167. The methods are really self-explanatory.
  168.  
  169. 
  170. THE DYNAMIC VECTOR OBJECT
  171.  
  172. This is simply a descendant of the Tcollection object (i.e. a
  173. collection of Floats), with some extra methods to do stuff that
  174. one would want to do with vectors which can shrink and grow.
  175. The implementation sees to it that indices start at one, not
  176. zero.
  177.  
  178.  
  179. constructor dynavec.init(alimit, adelta : integer);
  180.  
  181. Initializes the vector by calling the Tcollection init method,
  182. and sets all entries in the vector to zero by constructing the
  183. floats on the heap and inserting them into the collection.
  184.  
  185.  
  186. procedure dynavec.put(i: integer; num : double);
  187.  
  188. Changes the value of the i'th entry to num.  Posts an error in
  189. dynaerror if i doesn't make sense.
  190.  
  191.  
  192. function  dynavec.get(i: integer): double;
  193.  
  194. Returns the value of the i'th entry if i is OK, else posts an
  195. error in dynaerror.
  196.  
  197.  
  198. procedure dynavec.expandat(i : integer);
  199.  
  200. If i positive, expands the vector at position i.  Inserts a zero
  201. at index i and shifts all items one index up.  Expands after the
  202. last item if i doesn't make sense.
  203.  
  204.  
  205. procedure dynavec.contractat(i : integer);
  206.  
  207. Deletes and disposes the entry with index i and shifts items
  208. with higher indices down.  If i doesn't make sense, does nothing
  209. and posts an error in dynaerror.
  210.  
  211. function dynavec.norm : double;   {returns the norm of the object}
  212.  
  213. Returns the square root of the dotproduct of the vector with itself.
  214.  
  215. 
  216.  
  217. THE DYNAMIC MATRIX OBJECT
  218.  
  219.  
  220. The dynamat object is a desendant of tobject, and stores its entries
  221. in two collections of dynavecs, one for the rows, and one for the
  222. columns.  Entries are not duplicated.
  223.  
  224.  
  225. constructor dynamat.init(maxrow,maxcol : integer);
  226.  
  227. Initializes the matrix on the heap with maxcol columns and maxrow
  228. rows.  All entries are zero.
  229.  
  230. constructor dynamat.load(var s : tstream);
  231.  
  232. Reads the matrix from the stream s.
  233.  
  234. procedure dynamat.store(var s : tstream);
  235.  
  236. Stores the matrix on the stream s by writing nrow, ncol and then
  237. storing the rows from row 1 to row nrow.
  238.  
  239. procedure dynamat.addrow(i : integer);
  240.  
  241. Adds a row at rowindex i.  Rows with index>i shift up.  If i<1 the
  242. row is added before row 1, and if i>nrow the row is added as the last
  243. row.  All entries in the row are zero.  The columns are adjusted to
  244. reflect the additional row.
  245.  
  246. procedure dynamat.addcol(j : integer);
  247.  
  248. Adds a column to the matrix in the same way as described for addrow.
  249.  
  250.  
  251. procedure dynamat.deletecol(j : integer);
  252.  
  253. Deletes column j from the matrix, and disposes its entries.  Each row
  254. is adjusted to reflect the change.  If j doesn't make sense, posts an
  255. error in dynaerror.
  256.  
  257.  
  258. procedure dynamat.deleterow( i: integer);
  259.  
  260. Deletes row i from the matrix in the same way as described for
  261. deletecol.
  262.  
  263. function dynamat.get(i,j : integer): double;
  264.  
  265. Returns the value at row i, column j.  If the indices don't make
  266. sense, posts an error in neuralerror.
  267.  
  268. procedure dynamat.put(i,j : integer; value : double);
  269.  
  270. Sets the entry ast row i, column j to value.
  271.  
  272. procedure   dynamat.getrow(i : integer; var pvec : pdynavec);
  273.  
  274. Pvec should be nil on entry - this routine simply sets it to point to
  275. row i.  If i doesn't make sense, posts an error in dynaerror
  276.  
  277. procedure   dynamat.getcol(j : integer; var pvec : pdynavec);
  278.  
  279. Returns with pvec pointing at column j.  If j doesn't make sense,
  280. posts an error in dynaerror
  281.  
  282. destructor dynamat.done;
  283.  
  284. Disposes the rows and their entries, then deletes all entries in the
  285. columns and disposes the columns. Calls tobject.done.
  286.  
  287. THE CROUPIER OBJECT
  288.  
  289. This was constructed in order to present training data to a neural
  290. net in random order.  Some nets train better this way.  The Croupier
  291. deals from a dynavec object (the deck), but does not change it.
  292.  
  293. constructor Croupier.Init(size : integer);
  294.  
  295. Initializes decksize to size and constructs an index to randomly pick
  296. from.
  297.  
  298.  
  299. procedure Croupier.newdeck;
  300.  
  301. Calls index^.freeall and reconstructs index.  It is the users
  302. responsibility to call this method at the correct time during a long
  303. 'dealing' session, i.e. whenever the deck is exhausted.
  304.  
  305. function Croupier.Deal(deck : pcollection) : pointer;
  306.  
  307. Returns a pointer to the randomly selected entry in the deck.  The
  308. used entry in index is disposed.  If index is exhausted, returns NIL.
  309.  
  310. destructor Croupier.Done;
  311.  
  312. Disposes index and calls tobject.done
  313.  
  314.  
  315.  
  316.                       { ---- UNIT INITIALIZATION ----}
  317.  
  318.  
  319. begin randomize; dynaerror  := 0;
  320.  
  321.                    {Stream Registration}
  322.  
  323.      registertype(rfloat);
  324.      registertype(rcollection);
  325.      registertype(rdynavec);
  326.      registertype(rdynamat);
  327. end.
  328.  
  329.  
  330.